unit Commands ;

interface

uses
    Windows,
    Messages,
    SysUtils,
    Classes,
    Graphics,
    Controls,
    Forms,
    Dialogs,
    ActnList,
    ComCtrls,
    ToolWin,
    Menus,
    ImgList,
    ExtCtrls,
    dtpDocument,
    dtpPage,
    dtpShape,
    dtpTextShape,
    StdCtrls,
    dtpExposedMetafile,
    ExtDlgs,
    Gr32v1_5,
    dtpGroupShape,
    OptionRefs,
    Printers,
    dtpEffectShape,
    dtpColoreffects,
    dtpShadowEffects,
    ColorPickerButton,
    Jpeg,
    Math,
    ShellApi,
    dtpPolygonShape,
    dtpMemoShape,
    dtpLineShape,
    dtpResource,
    XPMan,
    VTHeaderPopup,
    VirtualTrees,
    VirtualScrollbox ;

type
    TCommandModule = class( TDataModule )
        ActionList : TActionList ;
        actNew : TAction ;
        actOpen : TAction ;
        actFileSave : TAction ;
        actFileSaveAs : TAction ;
        actClose : TAction ;
        actExit : TAction ;
        actZoomIn : TAction ;
        actZoomOut : TAction ;
        actZoomWidth : TAction ;
        actNewPage : TAction ;
        actInsertPage : TAction ;
        actAbout : TAction ;
        actPageEditName : TAction ;
        actDeletePages : TAction ;
        actGrid : TAction ;
        actDots : TAction ;
        actGroup : TAction ;
        actUnGroup : TAction ;
        actPageNext : TAction ;
        actPagePrev : TAction ;
        actCut : TAction ;
        actCopy : TAction ;
        actPaste : TAction ;
        actUndo : TAction ;
        actRedo : TAction ;
        actNone : TAction ;
        actMargins : TAction ;
        actThumbnails : TAction ;
        actPrintLayout : TAction ;
        actNormalLayout : TAction ;
        actSnap : TAction ;
        actToBack : TAction ;
        actToFront : TAction ;
        actMoveFront : TAction ;
        actMoveback : TAction ;
        actDeleteShapes : TAction ;
        actPrint : TAction ;
        actPrintCurrent : TAction ;
        actAutoThumb : TAction ;
        actHotzone : TAction ;
        actRender : TAction ;
        actDelete : TAction ;
        procedure actGroupExecute( Sender : TObject ) ;
        procedure actUnGroupExecute( Sender : TObject ) ;
        procedure actGridExecute( Sender : TObject ) ;
        procedure actDotsExecute( Sender : TObject ) ;
        procedure actPageEditNameExecute( Sender : TObject ) ;
        procedure actZoomInExecute( Sender : TObject ) ;
        procedure actZoomOutExecute( Sender : TObject ) ;
        procedure actZoomWidthExecute( Sender : TObject ) ;
        procedure actNewPageExecute( Sender : TObject ) ;
        procedure actPageNextExecute( Sender : TObject ) ;
        procedure actPagePrevExecute( Sender : TObject ) ;
        procedure actPageNextUpdate( Sender : TObject ) ;
        procedure actPagePrevUpdate( Sender : TObject ) ;
        procedure actPageEditNameUpdate( Sender : TObject ) ;
        procedure actUndoExecute( Sender : TObject ) ;
        procedure actRedoExecute( Sender : TObject ) ;
        procedure actRedoUpdate( Sender : TObject ) ;
        procedure actUndoUpdate( Sender : TObject ) ;
        procedure actGridUpdate( Sender : TObject ) ;
        procedure actDotsUpdate( Sender : TObject ) ;
        procedure actNoneExecute( Sender : TObject ) ;
        procedure actNoneUpdate( Sender : TObject ) ;
        procedure actFileSaveExecute( Sender : TObject ) ;
        procedure actFileSaveAsExecute( Sender : TObject ) ;
        procedure actGroupUpdate( Sender : TObject ) ;
        procedure actCutUpdate( Sender : TObject ) ;
        procedure actCopyUpdate( Sender : TObject ) ;
        procedure actPasteUpdate( Sender : TObject ) ;
        procedure actUnGroupUpdate( Sender : TObject ) ;
        procedure actMarginsExecute( Sender : TObject ) ;
        procedure actMarginsUpdate( Sender : TObject ) ;
        procedure actThumbnailsExecute( Sender : TObject ) ;
        procedure actThumbnailsUpdate( Sender : TObject ) ;
        procedure actPrintLayoutExecute( Sender : TObject ) ;
        procedure actPrintLayoutUpdate( Sender : TObject ) ;
        procedure actNormalLayoutExecute( Sender : TObject ) ;
        procedure actNormalLayoutUpdate( Sender : TObject ) ;
        procedure actSnapExecute( Sender : TObject ) ;
        procedure actSnapUpdate( Sender : TObject ) ;
        procedure actFileSaveUpdate( Sender : TObject ) ;
        procedure actPasteExecute( Sender : TObject ) ;
        procedure actPrintExecute( Sender : TObject ) ;
        procedure actPrintCurrentExecute( Sender : TObject ) ;
        procedure actPrintUpdate( Sender : TObject ) ;
        procedure actPrintCurrentUpdate( Sender : TObject ) ;
        procedure actAutoThumbExecute( Sender : TObject ) ;
        procedure actAutoThumbUpdate( Sender : TObject ) ;
        procedure actHotzoneExecute( Sender : TObject ) ;
        procedure actHotzoneUpdate( Sender : TObject ) ;
        procedure actRenderExecute( Sender : TObject ) ;
        procedure actRenderUpdate( Sender : TObject ) ;
        procedure actMovebackExecute( Sender : TObject ) ;
        procedure actMovebackUpdate( Sender : TObject ) ;
        procedure actMoveFrontExecute( Sender : TObject ) ;
        procedure actMoveFrontUpdate( Sender : TObject ) ;
        procedure actToBackExecute( Sender : TObject ) ;
        procedure actToBackUpdate( Sender : TObject ) ;
        procedure actToFrontExecute( Sender : TObject ) ;
        procedure actToFrontUpdate( Sender : TObject ) ;
        procedure actAboutExecute( Sender : TObject ) ;
        procedure actOpenExecute( Sender : TObject ) ;
        procedure actDeleteShapesExecute( Sender : TObject ) ;
        procedure actDeleteShapesUpdate( Sender : TObject ) ;
        procedure actDeletePagesExecute( Sender : TObject ) ;
        procedure actDeletePagesUpdate( Sender : TObject ) ;
        procedure actDeleteExecute( Sender : TObject ) ;
        procedure actDeleteUpdate( Sender : TObject ) ;
        procedure actExitExecute( Sender : TObject ) ;
        procedure actZoomInUpdate( Sender : TObject ) ;
        procedure actZoomOutUpdate( Sender : TObject ) ;
        procedure actZoomWidthUpdate( Sender : TObject ) ;
    private
        function GetCurrentDocument : TdtpComponent ;
        function GetSchematic : boolean ;
        { Private declarations }
    public
        { Public declarations }
        property CurrentDocument : TdtpComponent read GetCurrentDocument ;
        property Schematic : boolean read GetSchematic ;
    end ;

var
    CommandModule   : TCommandModule ;

implementation

{$R *.dfm}

uses
    frmMedax,
    frmAbout ;

{ TCommandModule }

function TCommandModule.GetCurrentDocument : TdtpComponent ;
begin
    case frmMain.PageControlDraw.ActivePageIndex of
        0 : Result := frmMain.DocumentSchema ;
        1 : Result := frmMain.DocumentPCB ;
    else
        Result := nil ;
    end ;
end ;

function TCommandModule.GetSchematic : boolean ;
begin
    Result := CurrentDocument = frmMain.DocumentSchema ;
end ;

procedure TCommandModule.actNoneExecute( Sender : TObject ) ;
begin
    CurrentDocument.HelperMethod := hmNone ;
end ;

procedure TCommandModule.actGridExecute( Sender : TObject ) ;
begin
    CurrentDocument.HelperMethod := hmGrid ;
end ;

procedure TCommandModule.actDotsExecute( Sender : TObject ) ;
begin
    CurrentDocument.HelperMethod := hmDots ;
end ;

procedure TCommandModule.actPageEditNameExecute( Sender : TObject ) ;
begin
    with frmMain.ListViewThumbs do
        if assigned( ItemFocused ) then
            ItemFocused.EditCaption ;
end ;

procedure TCommandModule.actGroupExecute( Sender : TObject ) ;
begin
    CurrentDocument.Group ;
end ;

procedure TCommandModule.actUnGroupExecute( Sender : TObject ) ;
begin
    CurrentDocument.Ungroup ;
end ;

procedure TCommandModule.actZoomInExecute( Sender : TObject ) ;
begin
    CurrentDocument.Tag := CurrentDocument.Tag * 2 ;
    CurrentDocument.ZoomPercent( CurrentDocument.Tag ) ;
end ;

procedure TCommandModule.actZoomOutExecute( Sender : TObject ) ;
begin
    CurrentDocument.Tag := CurrentDocument.Tag div 2 ;
    CurrentDocument.ZoomPercent( CurrentDocument.Tag ) ;
end ;

procedure TCommandModule.actZoomWidthExecute( Sender : TObject ) ;
begin
    CurrentDocument.Tag := 100 ;
    CurrentDocument.ZoomPercent( CurrentDocument.Tag ) ;
end ;

procedure TCommandModule.actNewPageExecute( Sender : TObject ) ;
begin
    frmMain.DocumentSchema.PageAdd( nil ) ;
end ;

procedure TCommandModule.actPageNextExecute( Sender : TObject ) ;
var
    APageIndex      : integer ;
begin
    with frmMain do
        if DocumentSchema.CurrentPageIndex < DocumentSchema.PageCount - 1 then begin
            APageIndex := frmMain.DocumentSchema.CurrentPageIndex + 1 ;
            Thumbs.Selected := nil ;
            Thumbs.Selected := Thumbs.Items[ APageIndex ] ;
            DocumentSchema.CurrentPageIndex := APageIndex ;
        end ;
end ;

procedure TCommandModule.actPagePrevExecute( Sender : TObject ) ;
var
    APageIndex      : integer ;
begin
    with frmMain do
        if DocumentSchema.CurrentPageIndex > 0 then begin
            APageIndex := DocumentSchema.CurrentPageIndex - 1 ;
            Thumbs.Selected := nil ;
            Thumbs.Selected := Thumbs.Items[ APageIndex ] ;
            DocumentSchema.CurrentPageIndex := APageIndex ;
        end ;
end ;

procedure TCommandModule.actUndoExecute( Sender : TObject ) ;
begin
    frmMain.DocumentSchema.Undo ;
end ;

procedure TCommandModule.actRedoExecute( Sender : TObject ) ;
begin
    // frmMain.DocumentSchema.Redo ;
end ;

procedure TCommandModule.actFileSaveExecute( Sender : TObject ) ;
begin
    with frmMain do begin
        if Length( DocFileName ) = 0 then begin
            actFileSaveAsExecute( Sender ) ;
            exit ;
        end ;
        SaveDocument ;
    end ;
end ;

procedure TCommandModule.actFileSaveAsExecute( Sender : TObject ) ;
begin
    with TSaveDialog.Create( nil ) do
        with frmMain do try
            Filter := cDtpDocumentFilter ;
            Title := 'Save Document' ;
            Options := Options + [ ofOverwritePrompt ] ;
            if Execute then begin
                DocFilename := Filename ;
                SaveDocument ;
            end ;
        finally
            Free ;
        end ;
end ;

procedure TCommandModule.actMarginsExecute( Sender : TObject ) ;
begin
    with frmMain.DocumentSchema do
        ShowMargins := not ShowMargins ;
end ;

procedure TCommandModule.actThumbnailsExecute( Sender : TObject ) ;
begin
    with frmMain do
        Thumbs.Visible := not Thumbs.Visible ;
end ;

procedure TCommandModule.actPrintLayoutExecute( Sender : TObject ) ;
begin
    with frmMain do
        DocumentSchema.ViewStyle := vsPrintLayout ;
end ;

procedure TCommandModule.actNormalLayoutExecute( Sender : TObject ) ;
begin
    with frmMain do
        DocumentSchema.ViewStyle := vsNormal ;
end ;

procedure TCommandModule.actSnapExecute( Sender : TObject ) ;
begin
    with frmMain.DocumentSchema do
        SnapToGrid := not SnapToGrid ;
end ;

procedure TCommandModule.actPasteExecute( Sender : TObject ) ;
begin
    frmMain.DocumentSchema.Paste ;
end ;

procedure TCommandModule.actPrintExecute( Sender : TObject ) ;
var
    i, Index, AStart, ACount : integer ;
    AFileName       : string ;
    ASelection      : array of integer ;
begin
    // Show the print dialog
    with frmMain do
        with TPrintDialog.Create( nil ) do try
            // Options
            Options := [ poPageNums ] ;
            if Thumbs.SelCount > 0 then
                Options := Options + [ poSelection ] ;
            // Pages
            MinPage := 1 ;
            FromPage := 1 ;
            MaxPage := FDocumentSchema.PageCount ;
            ToPage := FDocumentSchema.PageCount ;
            if Execute then begin
                // Print title
                if Length( DocFileName ) = 0 then
                    AFileName := cUntitled
                else
                    AFileName := ExtractFileName( DocFileName ) ;
                Printer.Title := AFileName ;
                // Range options
                if PrintRange = prAllPages then begin
                    // just print all pages
                    FDocumentSchema.Print ;
                end
                else if PrintRange = prSelection then begin
                    // Get the selected pages
                    with Thumbs do begin
                        ACount := SelCount ;
                        SetLength( ASelection, ACount ) ;
                        Index := 0 ;
                        for i := 0 to Items.Count - 1 do
                            if Items[ i ].Selected then begin
                                ASelection[ Index ] := i ;
                                inc( Index ) ;
                            end ;
                    end ;
                    FDocumentSchema.PrintSelection( ASelection, ACount ) ;
                end
                else begin
                    // From..to range
                    AStart := FromPage - 1 ;
                    ACount := ToPage - FromPage + 1 ;
                    FDocumentSchema.Print( AStart, ACount ) ;
                end ;
            end ;
        finally
            Free ;
        end ;
end ;

procedure TCommandModule.actPrintCurrentExecute( Sender : TObject ) ;
begin
    with frmMain.DocumentSchema do
        Print( CurrentPageIndex ) ;
end ;

procedure TCommandModule.actAutoThumbExecute( Sender : TObject ) ;
begin
    with frmMain.DocumentSchema do
        AutoPageUpdate := not AutoPageUpdate ;
end ;

procedure TCommandModule.actHotzoneExecute( Sender : TObject ) ;
begin
    with frmMain.DocumentSchema do
        case HotzoneScrolling of
            hzsWhenMouseDown : HotzoneScrolling := hzsNoScroll ;
        else
            HotzoneScrolling := hzsWhenMouseDown ;
        end ;
end ;

procedure TCommandModule.actRenderExecute( Sender : TObject ) ;
begin
    with frmMain.DocumentSchema do
        RenderAtScreenRes := not RenderAtScreenRes ;
end ;

procedure TCommandModule.actMovebackExecute( Sender : TObject ) ;
begin
    frmMain.DocumentSchema.MoveBack ;
end ;

procedure TCommandModule.actMoveFrontExecute( Sender : TObject ) ;
begin
    frmMain.DocumentSchema.MoveFront ;
end ;

procedure TCommandModule.actToBackExecute( Sender : TObject ) ;
begin
    frmMain.DocumentSchema.MoveToBackground ;
end ;

procedure TCommandModule.actToFrontExecute( Sender : TObject ) ;
begin
    frmMain.DocumentSchema.MoveToForeground ;
end ;

procedure TCommandModule.actAboutExecute( Sender : TObject ) ;
begin
    with TdlgAbout.Create( frmMain ) do try
        ShowModal ;
    finally
        Free ;
    end ;
end ;

procedure TCommandModule.actDeleteExecute( Sender : TObject ) ;
begin
    // Find out what to delete, pages or shapes
    with frmMain do
        if Thumbs.Focused then
            actDeletePagesExecute( Sender )
        else
            actDeleteShapesExecute( Sender ) ;
end ;

{ Updates }

procedure TCommandModule.actPageNextUpdate( Sender : TObject ) ;
begin
    with frmMain.DocumentSchema do
        actPageNext.Enabled := Schematic and ( CurrentPageIndex < PageCount - 1 ) ;
end ;

procedure TCommandModule.actPagePrevUpdate( Sender : TObject ) ;
begin
    with frmMain.DocumentSchema do
        actPagePrev.Enabled := Schematic and ( CurrentPageIndex > 0 ) ;
end ;

procedure TCommandModule.actPageEditNameUpdate( Sender : TObject ) ;
begin
    with frmMain do
        actPageEditName.Enabled := Schematic and ( assigned( Thumbs.Selected ) and Thumbs.Focused ) ;
end ;

procedure TCommandModule.actRedoUpdate( Sender : TObject ) ;
begin
    actRedo.Enabled := False ;
end ;

procedure TCommandModule.actUndoUpdate( Sender : TObject ) ;
begin
    actUndo.Enabled := CurrentDocument.UndoCount > 0 ;
end ;

procedure TCommandModule.actGridUpdate( Sender : TObject ) ;
begin
    with CurrentDocument do begin
        actGrid.Checked := HelperMethod = hmGrid ;
        actDots.Checked := HelperMethod = hmDots ;
        actNone.Checked := HelperMethod = hmNone ;
    end ;
end ;

procedure TCommandModule.actDotsUpdate( Sender : TObject ) ;
begin
    actGridUpdate( Sender ) ;
end ;

procedure TCommandModule.actNoneUpdate( Sender : TObject ) ;
begin
    actGridUpdate( Sender ) ;
end ;

procedure TCommandModule.actGroupUpdate( Sender : TObject ) ;
begin
    actGroup.Enabled := frmMain.SelectionCount > 1 ;
end ;

procedure TCommandModule.actUnGroupUpdate( Sender : TObject ) ;
begin
    actUnGroup.Enabled :=
        ( frmMain.SelectionCount = 1 ) and
        ( frmMain.DocumentSchema.Selection[ 0 ] is TdtpGroupShape ) ;
end ;

procedure TCommandModule.actCutUpdate( Sender : TObject ) ;
begin
    actCut.Enabled := frmMain.SelectionCount > 0 ;
end ;

procedure TCommandModule.actCopyUpdate( Sender : TObject ) ;
begin
    actCopy.Enabled := frmMain.SelectionCount > 0 ;
end ;

procedure TCommandModule.actPasteUpdate( Sender : TObject ) ;
begin
    // HasClipboardData actually peeks at the clipboard to see if there's
    // CF_TEXT, and if so, if the first few bytes contain XML.
    actPaste.Enabled := frmMain.DocumentSchema.HasClipboardData ;
end ;

procedure TCommandModule.actMarginsUpdate( Sender : TObject ) ;
begin
    with frmMain.DocumentSchema do
        if assigned( CurrentPage ) then
            with CurrentPage do
                actMargins.Checked := ShowMargins ;
end ;

procedure TCommandModule.actThumbnailsUpdate( Sender : TObject ) ;
begin
    with frmMain do
        actThumbnails.Checked := Thumbs.Visible ;
end ;

procedure TCommandModule.actPrintLayoutUpdate( Sender : TObject ) ;
begin
    with frmMain.DocumentSchema do
        actPrintLayout.Checked := ViewStyle = vsPrintLayout ;
end ;

procedure TCommandModule.actNormalLayoutUpdate( Sender : TObject ) ;
begin
    with frmMain.DocumentSchema do
        actNormalLayout.Checked := ViewStyle = vsNormal ;
end ;

procedure TCommandModule.actSnapUpdate( Sender : TObject ) ;
begin
    with frmMain.DocumentSchema do
        actSnap.Checked := SnapToGrid ;
end ;

procedure TCommandModule.actFileSaveUpdate( Sender : TObject ) ;
begin
    with frmMain.DocumentSchema do
        actFileSave.Enabled := Modified ;
end ;

procedure TCommandModule.actPrintUpdate( Sender : TObject ) ;
begin
    actPrint.Enabled := Printer.Printers.Count > 0
end ;

procedure TCommandModule.actPrintCurrentUpdate( Sender : TObject ) ;
begin
    actPrintCurrent.Enabled := Printer.Printers.Count > 0
end ;

procedure TCommandModule.actAutoThumbUpdate( Sender : TObject ) ;
begin
    with frmMain.DocumentSchema do
        actAutoThumb.Checked := AutoPageUpdate ;
end ;

procedure TCommandModule.actHotzoneUpdate( Sender : TObject ) ;
begin
    with frmMain.DocumentSchema do
        actHotzone.Checked := HotzoneScrolling = hzsWhenMouseDown ;
end ;

procedure TCommandModule.actRenderUpdate( Sender : TObject ) ;
begin
    with frmMain.DocumentSchema do
        actRender.Checked := RenderAtScreenRes ;
end ;

procedure TCommandModule.actMovebackUpdate( Sender : TObject ) ;
begin
    with frmMain do
        actMoveBack.Enabled :=
            ( SelectionCount > 0 ) and
            ( DocumentSchema.ShapeCount > SelectionCount ) ;
end ;

procedure TCommandModule.actMoveFrontUpdate( Sender : TObject ) ;
begin
    with frmMain do
        actMoveFront.Enabled :=
            ( SelectionCount > 0 ) and
            ( DocumentSchema.ShapeCount > SelectionCount ) ;
end ;

procedure TCommandModule.actToBackUpdate( Sender : TObject ) ;
begin
    with frmMain do
        actToBack.Enabled :=
            ( SelectionCount > 0 ) and
            ( DocumentSchema.ShapeCount > SelectionCount ) ;
end ;

procedure TCommandModule.actToFrontUpdate( Sender : TObject ) ;
begin
    with frmMain do
        actToFront.Enabled :=
            ( SelectionCount > 0 ) and
            ( DocumentSchema.ShapeCount > SelectionCount ) ;
end ;

procedure TCommandModule.actOpenExecute( Sender : TObject ) ;
begin
    with frmMain do begin
        if DocumentSchema.Modified then
            case AskSaveDocument of
                mrYes : actFileSave.Execute ;
                mrNo : ;
                mrCancel : exit ;
            end ;
        with TOpenDialog.Create( nil ) do begin
            try
                Filter := cDtpDocumentFilter ;
                Title := 'Load Document' ;
                if Execute then
                    LoadDocument( FileName ) ;
            finally
                Free ;
            end ;
        end ;
    end ;
end ;

procedure TCommandModule.actDeleteShapesExecute( Sender : TObject ) ;
begin
    with frmMain do
        DeleteSelectedShapes ;
end ;

procedure TCommandModule.actDeletePagesExecute( Sender : TObject ) ;
begin
    with frmMain do
        DeleteSelectedPages ;
end ;

procedure TCommandModule.actDeleteShapesUpdate( Sender : TObject ) ;
begin
    with frmMain do
        actDeleteShapes.Enabled :=
            DocumentSchema.SelectionCount > 0 ;             // Delete shape
end ;

procedure TCommandModule.actDeletePagesUpdate( Sender : TObject ) ;
begin
    with frmMain do
        actDeletePages.Enabled :=
            Thumbs.Focused and ( Thumbs.SelCount > 0 ) ;    // Delete page
end ;

procedure TCommandModule.actDeleteUpdate( Sender : TObject ) ;
begin
    with frmMain do
        actDelete.Enabled := Schematic and (
            ( Thumbs.Focused and ( Thumbs.SelCount > 0 ) ) or // Delete page
            ( DocumentSchema.SelectionCount > 0 ) ) ;       // Delete shape
end ;

procedure TCommandModule.actExitExecute( Sender : TObject ) ;
begin
    frmMain.Close ;
end ;

procedure TCommandModule.actZoomInUpdate( Sender : TObject ) ;
begin
    case CurrentDocument.Tag of
        25, 50, 100, 200 : actZoomIn.Enabled := True ;
        400 : actZoomIn.Enabled := False ;
    else
        CurrentDocument.Tag := 100 ;
    end ;
end ;

procedure TCommandModule.actZoomOutUpdate( Sender : TObject ) ;
begin
    case CurrentDocument.Tag of
        50, 100, 200, 400 : actZoomOut.Enabled := True ;
        25 : actZoomOut.Enabled := False ;
    else
        CurrentDocument.Tag := 100 ;
    end ;
end ;

procedure TCommandModule.actZoomWidthUpdate( Sender : TObject ) ;
begin
    actZoomWidth.Enabled := CurrentDocument.Tag <> 100 ;
end ;

end.

